home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 3.2 / Ham Radio Version 3.2 (Chestnut CD-ROMs)(1993).ISO / tty / tty22 / tty22.bas next >
BASIC Source File  |  1986-03-08  |  11KB  |  309 lines
  1. 5 'initialize
  2. 10 CLEAR: CLS: DEFINT A-Z: KEY OFF: FALSE=0: TRUE=NOT FALSE: OPTION BASE 0: DIM         A$(31,1): DIM C(128): DIVMSB=&H9: DIVLSB=&HE7: DIM S$(50): XX=1: LN=0
  3. 15 FOR I=1 TO 10: KEY I ,"": NEXT
  4. 17 XX=1:LN=0
  5. 20 GOTO 1000
  6. 25 '
  7. 30 REM *** The following gotos are dummies used as pointers.
  8. 40 GOTO 10000 ' *** subroutine to write header
  9. 50 GOTO 11000 ' *** subroutine to build translate table arrays.
  10. 60 GOTO 12000 ' *** subroutine to open comm file for receive.
  11. 70 GOTO 12500 ' *** open comm file for transmit
  12. 80 GOTO 13000 ' *** menu
  13. 85 GOTO 13500 ' ***change transmission speed
  14. 86 GOTO 13700 ' *** exit routines
  15. 90 GOTO 14000 ' *** Receive
  16. 95 GOTO 14800 ' *** receive error subroutine
  17. 100 GOTO 15000 ' *** Transmit
  18. 110 GOTO 15100 '*** transmit single character subroutine
  19. 120 GOTO 16000 ' *** function key routines
  20. 130 GOTO 18000 ' *** gosubs to send callsign -- cwid
  21. 200 '
  22. 999 '*** main program
  23. 1000 GOSUB 10000
  24. 1010 GOSUB 11000
  25. 1020 GOTO 13000
  26. 9997 END
  27. 9998 '
  28. 9999 REM *** Print Header
  29. 10000 LOCATE 3,5: PRINT CHR$(201);STRING$(29,205);CHR$(187)
  30. 10005 FOR I=4 TO 17: LOCATE I,5: PRINT CHR$(186);: LOCATE I,35:                          PRINT CHR$(186);: NEXT
  31. 10010 LOCATE 18,5: PRINT CHR$(200);STRING$(29,205);CHR$(188)
  32. 10020 COLOR 10,0: LOCATE 5,12: PRINT "***Murray/TTY***";: LOCATE 7,15: PRINT " de AA4L ";: LOCATE 9,12: PRINT "**Bob Johnson**";: COLOR 7,0
  33. 10030 LOCATE 11,14: PRINT "Version 2.2";: LOCATE 13,15: PRINT "2/14/1983";:              LOCATE 15,13: PRINT "Public domain";
  34. 10040 COLOR 18,0: LOCATE 20,5: PRINT "any key";: COLOR 2,0: BEEP
  35. 10050 Y$=INKEY$: IF Y$="" THEN 10050
  36. 10060 RETURN
  37. 10998 '
  38. 10999 REM *** Build translate tables
  39. 11000 'ascii to murray table for xmt
  40. 11020 DATA 0,0,0,0,0,0,0,133,0,0,2,0,0,8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,         141,145,148,137,0,154,139,143,146,0,0,140,131,156,157,150,151,147,129,          138,144,149,135,134,152,142,158,0,0,0,153,0
  41. 11030 DATA 3,25,14,9,1,13,26,20,6,11,15,18,28,12,24,22,23,10,5,16,7,30,19,29,21,        17,0,133,0,0,0,0,3,25,14,9,1,13,26,20,6,11,15,18,28,12,24,22,23,10,5,16,        7,30,19,29,21,17,0,0,0,0,0,0
  42. 11040 FOR I=0 TO 128:READ C(I):NEXT
  43. 11050 ' *** In the transmit table, chararacters which require the figs shift            have had hex `100' (decimal 128) added to the murray value.
  44. 11060 'murray to ascii table for rcv
  45. 11070 DATA "","",E,3,"","",A,-," "," ",S,"",I,8,U,7,"","",D,$,R,4,J,',N,",",F,!,      C,":",K,(,T,5,Z,"",L,),W,2,H,#,Y,6,P,0,Q,1,O,9,B,?,G,&,f,f,M,.,X,/,V,;,         ~,~
  46. 11080 FOR I=0 TO 31: FOR J=0 TO 1: READ A$(I,J): NEXT: NEXT: A$(5,1)=CHR$(7):           A$(17,1)=CHR$(34): A$(2,0)=CHR$(10): A$(2,1)=CHR$(10): A$(8,0)=CHR$(13):        A$(8,1)=CHR$(13)
  47. 11090 RETURN
  48. 11998 '
  49. 11999 REM *** open comm file for receive
  50. 12000 OPEN "COM1:110,N,5,2,RS,CS0,DS0,CD0" AS #1:WIDTH #1,255
  51. 12005 V=INP(&H3F9) 'save int reg status
  52. 12006 OUT &H3F9,0 'disable comm interrupts
  53. 12010 OUT &H3FB,(INP(&H3FB) OR 128) 'enable speed change
  54. 12020 OUT &H3F8,DIVLSB: OUT &H3F9,DIVMSB 'change speed
  55. 12030 OUT &H3FB,(INP (&H3FB) AND 127) 'restore
  56. 12035 OUT &H3F9,V 'restore int reg status
  57. 12040 RETURN
  58. 12498 '
  59. 12499 REM *** open comm file for transmit
  60. 12500 OPEN "COM1:110,N,5,2,CS0,DS0,CD0" AS #1:WIDTH #1,255
  61. 12505 V=INP(&H3F9) 'save int reg status
  62. 12506 OUT &H3F9,0 'disable comm interrupts
  63. 12510 OUT &H3FB,(INP(&H3FB) OR 128) 'enable speed change
  64. 12520 OUT &H3F8,DIVLSB: OUT &H3F9,DIVMSB 'change speed
  65. 12530 OUT &H3FB,(INP (&H3FB) AND 127) 'restore
  66. 12535 OUT &H3F9,V 'restore int reg status
  67. 12540 RETURN
  68. 12998 '
  69. 12999 REM *** MENU
  70. 13000 CLS
  71. 13010 PRINT "      *** Function Menu ***"
  72. 13020 PRINT
  73. 13030 PRINT "<1> Change transmission speed."
  74. 13040 PRINT "    Note: Default is 45.45 Baud (60 wpm).": PRINT
  75. 13050 PRINT "<2> Exit to BASIC.": PRINT
  76. 13060 PRINT "<3> Exit to DOS.": PRINT
  77. 13065 PRINT "<4> Switch to 110 baud ASCII": PRINT
  78. 13070 PRINT "<"+CHR$(24)+"> Receive": PRINT
  79. 13080 PRINT "<"+CHR$(25)+"> Transmit": PRINT
  80. 13085 DEF SEG=0: POKE 1050,PEEK (1052): POKE &H417,&H40: DEF SEG
  81. 13090 BEEP: PRINT "Enter Choice: "
  82. 13100 CHOICE$=INKEY$
  83. 13105 IF CHOICE$="" THEN 13100
  84. 13106 CLS
  85. 13110 IF LEN(CHOICE$)=2 THEN IF RIGHT$(CHOICE$,1)="P" THEN 15000 ELSE IF              RIGHT$(CHOICE$,1)="H" THEN 14000 ELSE GOTO 13010
  86. 13120 IF VAL(CHOICE$)=1 THEN 13500 ELSE IF VAL(CHOICE$)=2 THEN 13700 ELSE             IF VAL(CHOICE$)=3 THEN 13700 ELSE IF VAL(CHOICE$)=4 THEN CHAIN "asctty"         ELSE 13010
  87. 13130 STOP
  88. 13498 '
  89. 13499 REM *** Speed change
  90. 13500 CLS
  91. 13505 PRINT "       ** Select Transmission Speed **": PRINT
  92. 13510 PRINT "<1> 60 wpm .... 45.45 Baud": PRINT
  93. 13520 PRINT "<2> 75 wpm .... 56.92 Baud": PRINT
  94. 13530 PRINT "<3> 100 wpm ... 74.20 Baud": PRINT
  95. 13540 BEEP: PRINT "Enter choice: "
  96. 13550 CHOICE$=INKEY$
  97. 13560 IF CHOICE$="" THEN 13550
  98. 13570 CHOICE=VAL(CHOICE$)
  99. 13580 ON CHOICE GOTO 13600,13640,13680
  100. 13590 GOTO 13550
  101. 13595 '
  102. 13600 DIVMSB=&H9: DIVLSB=&HE7: GOTO 13000
  103. 13639 '
  104. 13640 DIVMSB=&H7: DIVLSB=&HE8: GOTO 13000
  105. 13679 '
  106. 13680 DIVMSB=&H6: DIVLSB=&H11: GOTO 13000
  107. 13698 '
  108. 13699 REM *** Exit to BASIC
  109. 13700 PRINT : PRINT : PRINT "Off at ";DATE$;"    ";TIME$
  110. 13710 IF PRN THEN PRINT#2,: PRINT#2,"Off at ";DATE$;"     ";TIME$
  111. 13720 CLOSE
  112. 13730 IF VAL(CHOICE$)=3 THEN 13750
  113. 13740 END
  114. 13750 SYSTEM
  115. 13800 STOP
  116. 13998 '
  117. 13999 REM *** Receive Routine
  118. 14000 PRINT :PRINT :PRINT DATE$ SPC(5) TIME$
  119. 14003 Y=CSRLIN
  120. 14005 SHFT=0
  121. 14010 LOCATE 25,1: COLOR 0,7
  122. 14020 PRINT" F1=> cr & lf on/off ... F2=> printer on/off ... F10=> menu ... <"+CHR$(25)+">=> transmit ";: COLOR 7,0:LOCATE Y,1
  123. 14025 DEF SEG =0: POKE 1050, PEEK(1052): DEF SEG
  124. 14030 ON KEY(1) GOSUB 14900: KEY(1) ON
  125. 14040 ON KEY(2) GOSUB 14920: KEY(2) ON
  126. 14050 ON KEY(10) GOSUB 14940: KEY(10) ON
  127. 14060 ON KEY(14) GOSUB 14960: KEY(14) ON
  128. 14065 GOSUB 12000
  129. 14066 ON ERROR GOTO 14800
  130. 14070 IF MENU.RET OR XMT.FL THEN 14080 ELSE 14100
  131. 14080 KEY(1) OFF: KEY(2) OFF: KEY(10) OFF: KEY(14) OFF: ON ERROR GOTO 0:              CLOSE #1
  132. 14090 IF MENU.RET THEN MENU.RET = FALSE: GOTO 13000
  133. 14095 IF XMT.FL THEN XMT.FL=FALSE: GOTO 15000
  134. 14099 '
  135. 14100 IF EOF(1) THEN 14400
  136. 14110 X$=INPUT$(LOC(1),#1)
  137. 14120 FOR I=1 TO LEN(X$)
  138. 14130   MU$=MID$(X$,I,1): IF ASC(MU$)>31 THEN 14210
  139. 14140   AS$=A$(ASC(MU$),SHFT)
  140. 14150   IF AS$=CHR$(13) THEN 14210
  141. 14160   IF AS$=" " THEN SHFT=0: GOTO 14200
  142. 14170   IF AS$=CHR$(10) THEN SHFT=0: IF CRLF THEN AS$=CHR$(13) ELSE AS$=" ":            GOTO 14200
  143. 14180   IF AS$="f" THEN SHFT=1: GOTO 14210
  144. 14190   IF AS$="~" THEN SHFT=0: GOTO 14210
  145. 14200   PRINT AS$;: IF PRN THEN PRINT #2,AS$;
  146. 14210   NEXT
  147. 14220 GOTO 14070
  148. 14399 '
  149. 14400 K$=INKEY$: IF K$="" THEN 14070
  150. 14405 IF LEN(K$)>1 THEN 14070
  151. 14410 Y=CSRLIN: X=POS(0)
  152. 14420 S$(LN)=S$(LN)+K$
  153. 14425 IF K$=CHR$(13) THEN LN =LN+1: XX=1: GOTO 14070
  154. 14430 LOCATE 25,XX,1
  155. 14440 PRINT K$+" █";
  156. 14450 XX=XX+1
  157. 14460 IF XX=>75 THEN S$(LN)=S$(LN)+CHR$(13): XX=1: LN=LN+1
  158. 14470 LOCATE Y,X
  159. 14480 GOTO 14070
  160. 14799 '
  161. 14800 IF ERR=25 OR ERR=27 THEN 14810 ELSE 14820
  162. 14810 PRINT: PRINT "check printer": BEEP: PRINT: RESUME
  163. 14820 IF ERR=57 THEN RESUME NEXT
  164. 14830 ON ERROR GOTO 0
  165. 14840 '
  166. 14899 '
  167. 14900 IF CRLF THEN CRLF=FALSE ELSE CRLF=TRUE
  168. 14905 RETURN
  169. 14910 '
  170. 14920 IF NOT PRN THEN OPEN "lpt1:" FOR OUTPUT AS #2: PRN=TRUE: WIDTH #2,255:          RETURN
  171. 14925 CLOSE #2: PRN=FALSE: RETURN
  172. 14930 '
  173. 14940 MENU.RET=TRUE: RETURN
  174. 14950 '
  175. 14960 XMT.FL=TRUE: RETURN
  176. 14970 '
  177. 14998 '
  178. 14999 '*** transmit
  179. 15000 PRINT: PRINT: PRINT DATE$ SPC(5) TIME$
  180. 15010 Y=CSRLIN
  181. 15020 SHIFT=FALSE
  182. 15030 COLOR 0,7: LOCATE 25,1
  183. 15040 PRINT" F1-F3=>Msg1-3 \ F4=>CQ \ F5=>de \ F6=>Test \ F7=>id \ F10=>Menu \ "+CHR$(24)+"=>Receive  ";
  184. 15050 COLOR 7,0: LOCATE Y,1,1
  185. 15060 GOSUB 12500
  186. 15070 DEF SEG=0: POKE 1050,PEEK(1052): DEF SEG
  187. 15080 X$=INKEY$: IF X$="" THEN 15080
  188. 15090 IF LEN(X$)>1 THEN 15200
  189. 15092 GOSUB 15100
  190. 15093 GOTO 15080
  191. 15098 '
  192. 15099 '*** this subroutine converts a character from ascii to murray                   and transmits it
  193. 15100 IF X$=CHR$(13) THEN PRINT X$;: PRINT #1,CHR$(2)+CHR$(8)+CHR$(31);: SHIFT=FALSE: RETURN
  194. 15110 IF X$=" " THEN PRINT X$;: PRINT #1,CHR$(4)+CHR$(31);: SHIFT=FALSE: RETURN
  195. 15120 MU=C(ASC(X$)): IF MU=0 THEN RETURN
  196. 15130 IF MU>127 THEN IF NOT SHIFT THEN SHIFT=TRUE: PRINT #1,CHR$(27);
  197. 15135 IF MU>127 THEN MU=MU-128: GOTO 15150
  198. 15140 IF SHIFT THEN SHIFT=FALSE: PRINT #1,CHR$(31);
  199. 15150 PRINT #1,CHR$(MU);: PRINT X$;
  200. 15160 RETURN
  201. 15199 '
  202. 15200 Z=INSTR(";<=>?@ADHC",RIGHT$(X$,1))
  203. 15210 ON Z GOTO 16000,16100,16200,16300,16400,16500,16600,16700,16800,16900
  204. 15220 GOTO 15080
  205. 15998 '
  206. 15999 '*** routines to handle function keys
  207. 16000 FILENM$="msg1"
  208. 16010 GOSUB 17000
  209. 16020 GOTO 15080
  210. 16099 '
  211. 16100 FILENM$="msg2"
  212. 16110 GOSUB 17000
  213. 16120 GOTO 15080
  214. 16199 '
  215. 16200 FILENM$="msg3"
  216. 16210 GOSUB 17000
  217. 16220 GOTO 15080
  218. 16299 '
  219. 16300 MSG$=CHR$(13)+"cq cq cq cq cq cq cq de aa4l aa4l aa4l bob in raleigh nc"
  220. 16310 GOSUB 17500
  221. 16320 GOTO 15080
  222. 16399 '
  223. 16400 MSG$=CHR$(13)+"de aa4l aa4l bob in raleigh nc"
  224. 16410 GOSUB 17500
  225. 16420 GOTO 15080
  226. 16499 '
  227. 16500 MSG$=CHR$(13)+"the quick brown fox jumped over the lazy dog's back"+CHR$(13)+"ryryryryryryryryryryryryryryryryryryryryryryryryryryryry"+CHR$(13)+"1m2m3m4m5m6m7m8m9m0"
  228. 16510 GOSUB 17500
  229. 16520 GOTO 15080
  230. 16599 '
  231. 16600 MSG$=CHR$(13)+"cw id:"
  232. 16610 GOSUB 17500
  233. 16620 CLOSE #1 'close file to purge buffer
  234. 16625 GOSUB 12500 'reopen file to key transmitter
  235. 16630 GOSUB 18000
  236. 16640 GOTO 15080
  237. 16699 '
  238. 16700 CLOSE#1: LOCATE 25,1: PRINT SPACE$(79): GOTO 13000
  239. 16799 '
  240. 16800 CLOSE#1: GOTO 14000
  241. 16888 '
  242. 16889 '***transmit keybd buffer
  243. 16900 FOR II = 0 TO LN-1
  244. 16910 MSG$=S$(II)
  245. 16920 GOSUB 17500
  246. 16925 S$(II)=""
  247. 16930 NEXT II
  248. 16940 LN=0: XX=1
  249. 16950 GOTO 15080
  250. 16998 '
  251. 16999 '*** subroutine to get a message from disk and transmit it
  252. 17000 ON ERROR GOTO 17300
  253. 17010 OPEN FILENM$ FOR INPUT AS #3
  254. 17020 WHILE NOT EOF(3)
  255. 17030   LINE INPUT #3,M$
  256. 17040   MSG$=CHR$(13)+M$
  257. 17050   GOSUB 17500
  258. 17060 WEND
  259. 17070 CLOSE #3
  260. 17075 ON ERROR GOTO 0
  261. 17080 GOTO 15080
  262. 17298 '
  263. 17299 '*** disk error
  264. 17300 IF ERR=53 OR ERR=71 OR ERR=72 THEN PRINT"***Can't read file for ";FILENM$;"***";:CLOSE #3: RESUME 15080
  265. 17310 ON ERROR GOTO 0
  266. 17498 '
  267. 17499 '*** subroutine to transmit a msg
  268. 17500 FOR I=1 TO LEN(MSG$)
  269. 17510   X$=MID$(MSG$,I,1)
  270. 17520   GOSUB 15100
  271. 17530 NEXT
  272. 17540 RETURN
  273. 17998 '
  274. 17999 '*** cwid
  275. 18000 SOUND 32767,20
  276. 18010 GOSUB 18500
  277. 18020 GOSUB 18600
  278. 18030 GOSUB 18700 'A
  279. 18040 GOSUB 18500
  280. 18050 GOSUB 18600
  281. 18060 GOSUB 18700 'A
  282. 18070 GOSUB 18500
  283. 18080 GOSUB 18500
  284. 18090 GOSUB 18500
  285. 18100 GOSUB 18500
  286. 18110 GOSUB 18600
  287. 18120 GOSUB 18700 '4
  288. 18130 GOSUB 18500
  289. 18140 GOSUB 18600
  290. 18150 GOSUB 18500
  291. 18160 GOSUB 18500
  292. 18170 SOUND 32767,20  'L
  293. 18180 SOUND 32767,1
  294. 18190 RETURN
  295. 18498 '
  296. 18499 '***DIT SUBROUTINE
  297. 18500 SOUND 800,1.5: MOTOR 1
  298. 18510 SOUND 32767,1.5: MOTOR 0
  299. 18520 RETURN
  300. 18598 '
  301. 18599 '***dah subroutine
  302. 18600 SOUND 800,4.5: MOTOR 1
  303. 18610 SOUND 32767,1.5: MOTOR 0
  304. 18620 RETURN
  305. 18698 '
  306. 18699 '***inter-character space subroutine
  307. 18700 SOUND 32767,3
  308. 18710 RETURN
  309.